home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
PWAULTP3.ZIP
/
PWAPRGMS.A02
/
PWA95
/
PWAECJ15.ZIP
/
JOIN.PPS
< prev
next >
Wrap
Text File
|
1995-04-09
|
13KB
|
395 lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Conference Join v1.5
; 1.2 Written by Drew [PWA] / 1.5 Revised by Nemesis
; Source last updated 04-09-95
;
; Written in PPL 3.0 for PCBoard 15.2+ only.
;
; Description: Generates a "menu" of conferences a user can join. If a user
; does not have access to a conference, that conference never shows up in the
; list. :)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; procedure & function declarations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
declare procedure Initialize()
declare procedure Lightbar()
declare procedure PrintConfs()
declare procedure ShowHeader()
declare function BuildConfInfo(int i, word recsize) integer
declare procedure PrintLineForConf(int i, string shortname, int offset)
declare procedure ShowFooter()
declare procedure RestoreOldConf()
*$USEFUNCS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; global variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
string cnames@ ; cnames.@@@
string cnamesa ; cnames.add
string pattern ; line to print for conferences
string lbprompt ; prompt to print for lightbar options
string hilightcolor ; color code to use for lightbar
integer cur ; current conference being printed by PrintConf
integer startline ; Y position of first conference on screen
integer numtoprint ; max numb of conf's to print per screen
integer oldconf ; stores user's conf num prior to running this ppe
integer printed ; stores number of lines printed on current page
word recordsize
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; main body of program
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
begin
Initialize()
PrintConfs()
RestoreOldConf()
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; restores to the user's previous conference before running this ppe
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure RestoreOldConf()
lastin oldconf
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Lightbar for Conference Selection
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure Lightbar()
string response,saveline
string Shortname
int optnum
int TempCur
int Reqlev
boolean PubConf
boolean done
print lbprompt
optnum = 1
done = false
while (!done) do
saveline = scrtext(1,optnum+startline,79,true)
ansipos 1,optnum + Startline
print hilightcolor+scrtext(1,optnum+startline,79,false)+"@X01"
ansipos 1,optnum + Startline
response = ""
while (!done) do
response = upper(inkey())
select case (response)
case "9","3","S","X","8","2","A","Z","Q","M",CHR(13),"UP","DOWN","PGUP","PGDN"
done=true
end select
end while
done = false
select case (response)
case "A","UP","8"
ansipos 1,optnum + startline
print saveline
optnum = optnum - 1
if (optnum = 0) optnum = printed
case "Z","DOWN","2"
ansipos 1,optnum + startline
print saveline
optnum = optnum + 1
if (optnum = printed + 1) then
if (printed = numtoprint) done = true
optnum=1
endif
case "PGDN","3","X"
done = true
ansipos 1 , printed + startline + 1
case "PGUP","9","S"
TempCur = S2I(Left(scrtext(1,1+startline,79,false),4),10) - 1
Printed = 0
While ((TempCur > -1) & (Printed < NumtoPrint)) do
Fseek 1, Recordsize * TempCur + 2, Seek_Set
fread 1, shortname, 14
if (strip(shortname, " ") != "") then
fread 1, pubconf, 1
if (pubconf = TRUE) then
fseek 1, 5, seek_cur
fread 1, reqlev, 2
if (u_sec >= reqlev) then
Printed = Printed + 1
end if
end if
end if
TempCur = TempCur - 1
end while
Cur = TempCur
Done = true
case "M"
RestoreOldConf()
ansipos 1, u_pagelen
stop
case "Q", "ESCAPE"
RestoreOldConf()
ansipos 1, u_pagelen
kbdstuff chr(13)
end
case chr(13)
if (optnum < printed + 1) then
kbdstuff Left(scrtext(1,optnum + startline,79,false),4)+chr(13)
ansipos 1, u_pagelen
stop
else
done = true
endif
end select
end while
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Prints the conferences
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure PrintConfs()
int i
getuser
printed = 0
fopen 1, cnames@, o_rd, s_dn
fopen 2, cnamesa, o_rd, s_dn
fread 1, recordsize, 2
ShowHeader()
startline = gety() - 1
Cur = 0
While (Cur <= hiconfnum()) do
printed = printed + BuildConfInfo(Cur, recordsize)
if ((printed == numtoprint) | (Cur=hiconfnum())) then
ShowFooter()
LightBar()
printed = 0
ShowHeader()
endif
Cur = Cur + 1
end while
fclose 1
fclose 2
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; checks whether or not to print the current conference. returns 1 (true)
; if the conference is available to the user, 0 (false) if not.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function BuildConfInfo(int confnum, word recordsize) integer
boolean pubconf
string shortname
int reqlev, offset
fseek 1, recordsize * Cur+2, Seek_Set
fread 1, shortname, 14
; first check if the conference even has a name or not. if it
; has no name, then it doesn't exist
;
if (strip(shortname, " ") != "") then
; check if it's a public conference. if so, then check sec lev;
; otherwise it's private, so check if user is reg'ed in the conf
;
fread 1, pubconf, 1
if (pubconf = TRUE) then
fseek 1, 5, seek_cur
fread 1, reqlev, 2
; check sec level
if (u_sec >= reqlev) then
PrintLineForConf(confnum, shortname, 0)
BuildConfInfo = 1
else
fseek 1, recordsize - 22, seek_cur
BuildConfInfo = 0
endif
else
if (confreg(confnum)) then
PrintLineForConf(confnum, shortname, 7)
BuildConfInfo = 1
else
fseek 1, (recordsize - 14) - 1, seek_cur
BuildConfInfo = 0
endif
endif
else
; if we're here, then it's a "blank" conference, so skip to the
; next conference. (recordsize - 14) is the conf record size minus
; the conf name (since we've already read the name).
;
fseek 1, recordsize - 14, seek_cur
BuildConfInfo = 0
endif
endfunc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; prints a line for the current conference. "offset" here can be of two
; values: 0 or 7. 0 indicates we've already read the required security
; level of a conference, 7 indicates we haven't. we jump forward this many
; bytes to start getting the other information (msgs, doors, etc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure PrintLineForConf(int confnum, string shortname, int offset)
string newpattern, tmpstr1
lastin confnum
newpattern = pattern
; conference number
;
newpattern = replacestr(newpattern, "%N%", string(confnum))
; gets the long name from cnamesa. this is a somewhat retarded way to do
; it since for long names, only characters after the 14th character are
; stored in cnames.add. the first 14 characters are from pcb 15.1, where
; it's still stored in cnames.@@@. hence, we pass in the first 14 chars
; as a parameter since we read it already, then we grab whatever is left
; from cnames.add and concatenate the two. this "method" is from
; cnfn.pps, clark dev's own ppe used on salt air.
;
fseek 2, confnum * 256 + 208, SEEK_SET
fread 2, tmpstr1, 48
tmpstr1 = shortname + tmpstr1
newpattern = replacestr(newpattern, "%C%", string(tmpstr1))
; msgs file
;
fseek 1, offset + 5, seek_cur
fread 1, tmpstr1, 32
if (tmpstr1 == "") then
newpattern = replacestr(newpattern, "%M%", "No")
else
newpattern = replacestr(newpattern, "%M%", "Yes")
endif
; doors.lst
; 96 + 30 + 27 + 29 + 26 + 29 = 237
;
fseek 1, 237, seek_cur
fread 1, tmpstr1, 33
if (tmpstr1 == "") then
newpattern = replacestr(newpattern, "%D%", "No")
else
newpattern = replacestr(newpattern, "%D%", "Yes")
endif
; blt.lst
;
fseek 1, 29, seek_cur
fread 1, tmpstr1, 33
if (tmpstr1 == "") then
newpattern = replacestr(newpattern, "%B%", "No")
else
newpattern = replacestr(newpattern, "%B%", "Yes")
endif
; script.lst
;
fseek 1, 29, seek_cur
fread 1, tmpstr1, 33
if (tmpstr1 == "") then
newpattern = replacestr(newpattern, "%S%", "No")
else
newpattern = replacestr(newpattern, "%S%", "Yes")
endif
; dir.lst for file directories existence
;
fseek 1, 62, seek_cur
fread 1, tmpstr1, 33
if (tmpstr1 == "") then
newpattern = replacestr(newpattern, "%F%", "No")
else
newpattern = replacestr(newpattern, "%F%", "Yes")
endif
; high message number
;
if (instr(newpattern, "%HM%")) then
newpattern = replacestr(newpattern, "%HM%", himsgnum())
endif
; last message number read
;
if (instr(newpattern, "%LR%")) then
newpattern = replacestr(newpattern, "%LR%", u_lmr(confnum))
endif
lastin oldconf
println newpattern
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; shows the footer file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure ShowFooter()
if (exist(ppepath() + "JOIN.BOT")) then
dispfile ppepath() + "JOIN.BOT", DEFS
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; shows the header file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure ShowHeader()
if (exist(ppepath() + "JOIN.TOP")) then
dispstr "%" + ppepath() + "JOIN.TOP"
endif
endproc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; initialize
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure Initialize()
if (exist(ppepath() + "JOIN.CFG")) then
cnames@ = readline(pcbdat(), 31) + ".@@@"
if (!exist(cnames@)) then
println cnames@ + " does not exist. Bad path in PCBOARD.DAT"
end
endif
cnamesa = readline(pcbdat(), 31) + ".ADD"
if (!exist(cnamesa)) then
println cnamesa + " does not exist. Bad path in PCBOARD.DAT"
end
endif
else
println ppepath() + "JOIN.CFG does not exist! Exiting."
end
endif
numtoprint = s2i(readline(ppepath() + "JOIN.CFG", 1), 10)
pattern = readline(ppepath() + "JOIN.CFG", 2)
lbprompt = readline(ppepath() + "JOIN.CFG", 3)
hilightcolor = readline(ppepath() + "JOIN.CFG", 4)
fclose -1
; we need to store the user's conf num they were in prior to this ppe
; since we use "lastin" to change the active conf num in order to find
; out the number of msgs per conf.
;
oldconf = curconf()
endproc